home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1996 May: Tool Chest / Developer CD Series May 1996 (Tool Chest) (Apple Computer) (1996).iso / Tool Chest / Development Tools & Languages / Dylan Related / Mindy / Mindy 1.2 - portable sources / libraries / string-ext / substring-search.dylan < prev   
Encoding:
Text File  |  1995-03-15  |  8.0 KB  |  207 lines  |  [TEXT/ttxt]
  1. module:     substring-search
  2. author:     Robert Stockton (rgs@cs.cmu.edu)
  3. synopsis:    Provides a small assortment of specialized operations for
  4.         searching and modifying <byte-string>s.  These
  5.         operations are analogous to existing collection operations but
  6.         provide keywords and efficiency improvements which are
  7.         meaningful only within the more limited domain.
  8.                 (used to be strsearch.dylan in module string-search library 
  9.         collection-extensions)
  10. copyright:  Copyright (C) 1994, Carnegie Mellon University.
  11.             All rights reserved.
  12. rcs-header: $Header: substring-search.dylan,v 1.2 94/11/09 23:08:40 nkramer Exp $
  13.  
  14. //======================================================================
  15. //
  16. // Copyright (c) 1994  Carnegie Mellon University
  17. // All rights reserved.
  18. // 
  19. // Use and copying of this software and preparation of derivative
  20. // works based on this software are permitted, including commercial
  21. // use, provided that the following conditions are observed:
  22. // 
  23. // 1. This copyright notice must be retained in full on any copies
  24. //    and on appropriate parts of any derivative works.
  25. // 2. Documentation (paper or online) accompanying any system that
  26. //    incorporates this software, or any part of it, must acknowledge
  27. //    the contribution of the Gwydion Project at Carnegie Mellon
  28. //    University.
  29. // 
  30. // This software is made available "as is".  Neither the authors nor
  31. // Carnegie Mellon University make any warranty about the software,
  32. // its performance, or its conformity to any specification.
  33. // 
  34. // Bug reports, questions, comments, and suggestions should be sent by
  35. // E-mail to the Internet address "gwydion-bugs@cs.cmu.edu".
  36. //
  37. //======================================================================
  38.  
  39. //======================================================================
  40. // The "string-search" module provides basic search and replace
  41. // capabilities upon <byte-string>.  Exploiting the known properties
  42. // of these types yields substantially better performance than can be
  43. // achieved for sequences in general.
  44. //======================================================================
  45.  
  46. define constant <integer?> = union(<integer>, singleton(#f));
  47.  
  48.  
  49. //     This is a specialized version of subsequence-position which works only
  50. //     on <byte-strings>.  Since this routine only handles byte-characters and
  51. //     \== tests, it can do a "Boyer-Moore-ish" search.  (If the pattern is
  52. //     too small for B-M to pay off, substring-position will fall back upon a
  53. //     simpler search strategy -- this function should never be slower than
  54. //     subsequence-position.) 
  55. //
  56. define method substring-position 
  57.     (big :: <byte-string>, pattern :: <byte-string>, #key start = 0,
  58.      end: big-end = size(big), case-sensitive = #f)
  59.  => (position :: <integer?>, #rest end-position :: <integer>);
  60.   let comparison = if (case-sensitive) \= else case-insensitive-equal end;
  61.   let compiled-pattern = compile-substring(pattern, comparison);
  62.   find-substring(big, pattern, start, big-end, comparison, compiled-pattern);
  63. end method substring-position;
  64.  
  65.  
  66. define method make-substring-positioner 
  67.     (pattern :: <byte-string>, #key case-sensitive = #f)
  68.  => positioner :: <function>;
  69.   let comparison = if (case-sensitive) \= else case-insensitive-equal end;
  70.   let compiled-pattern = compile-substring(pattern, comparison);
  71.   method (big :: <byte-string>, #key start = 0, end: big-end = size(big))
  72.    => (position :: <integer?>, #rest end-position :: <integer>);
  73.     find-substring(big, pattern, start, big-end, comparison, compiled-pattern);
  74.   end method;
  75. end method make-substring-positioner;
  76.  
  77.  
  78. // Does the real work of substring-position.  Not exported.
  79. //
  80. // Specialized version of "subsequence-position" specialized for byte-strings.
  81. // Since this routine only handles byte-characters and "==" tests, it can do
  82. // a Boyer-Moore-ish search.  As a further optimization, you may pre-compile
  83. // the pattern with "compile-substring" and pass it in as the "compiled:"
  84. // keyword.  This will save both time and space if you are searching for the
  85. // same pattern repeatedly.
  86. //
  87. define method find-substring (big :: <byte-string>,
  88.                   pattern :: <byte-string>,
  89.                   start :: <integer>, big-end :: <integer>,
  90.                   equal? :: <function>, compiled-pattern)
  91.  => (position :: <integer?>, #rest end-position :: <integer>);
  92.   let pat-sz = size(pattern);
  93.   let start-of-occurence
  94.     = select (pat-sz)
  95.     0 =>            // empty string always matches
  96.       start;
  97.     1 =>            // simple character search
  98.       let ch = pattern[0];
  99.       for (key from start below big-end,
  100.            until equal?(big[key], ch))
  101.       finally
  102.         if (key < big-end) key else #f end;
  103.       end for;
  104.     2 =>            // pairs of characters -- starting to get
  105.       let ch1 = pattern[0];    // marginal 
  106.       let ch2 = pattern[1];
  107.       for (key from start below big-end - 1,
  108.            until equal?(big[key], ch1) & equal?(big[key + 1], ch2))
  109.       finally
  110.         if (key < (big-end - 1)) key else #f end;
  111.       end for;
  112.     otherwise =>        // It's worth doing something Boyer-Moore-ish
  113.       let pat-last = pat-sz - 1;
  114.       let last-char = pattern[pat-last];
  115.       let skip = compiled-pattern;
  116.       local method search(index)
  117.           if (index >= big-end)    // past end of big -- it's not here
  118.             #f;
  119.           else 
  120.             let char = big[index];
  121.             if (equal?(char, last-char)) 
  122.               // maybe it's here -- we'd better check
  123.               for (pat-key from 0 below pat-last,
  124.                big-key from index - pat-last,
  125.                while equal?(big[big-key], pattern[pat-key]))
  126.               finally
  127.             if (pat-key == pat-last) // fell off end -- found it.
  128.               index - pat-last;
  129.             else
  130.               search(index + 1) // no luck -- try further down
  131.             end if;
  132.               end for;
  133.             else    // last character didn't match, so we can use
  134.                     // the "skip table" to optimize
  135.               search(index + skip[as(<fixed-integer>, char)]);
  136.             end if;
  137.           end if;
  138.         end method;
  139.       search(start + pat-last);
  140.       end select;
  141.   if (start-of-occurence)
  142.     values(start-of-occurence, start-of-occurence + pat-sz);
  143.   else
  144.     #f;
  145.   end if;
  146. end method find-substring;
  147.  
  148.  
  149. // Used by positioners.  Not exported.
  150. //
  151. // Produce a skip table for Boyer-Moore-ish searching.  By splitting this off
  152. // into a separate routine we allow people to pre-compile heavily used
  153. // strings, thus avoiding one of the more expensive parts of the search.
  154. //
  155. define method compile-substring
  156.     (pattern :: <byte-string>, equal? :: one-of(\=, case-insensitive-equal))
  157.  => (compiled);
  158.   let sz = size(pattern);
  159.   if (sz < 3)
  160.     #();
  161.   else
  162.     let result = make(<vector>, size: 256, fill: sz);
  163.     for (index from 0 below sz - 1, skip from sz - 1 by -1)
  164.       if (equal? == case-insensitive-equal)
  165.     result[as(<fixed-integer>, as-lowercase(pattern[index]))] := skip;
  166.     result[as(<fixed-integer>, as-uppercase(pattern[index]))] := skip;
  167.       else
  168.     result[as(<fixed-integer>, pattern[index])] := skip;
  169.       end if;
  170.     end for;
  171.     result;
  172.   end if;
  173. end method compile-substring;
  174.  
  175.  
  176. define method substring-replace 
  177.     (big :: <byte-string>, search-for :: <byte-string>, 
  178.      replace-with :: <byte-string>, #key count, start = 0, 
  179.      end: input-end = size(big))
  180.  => replaced-string :: <byte-string>;
  181.   let positioner = make-substring-positioner(search-for);
  182.   do-replacement(positioner, replace-with, big, start, input-end, count, #f);
  183. end method substring-replace;
  184.  
  185.  
  186. define method make-substring-replacer
  187.     (search-for :: <byte-string>, #key replace-with, case-sensitive = #f)
  188.  => replacer :: <function>;
  189.   let positioner = make-substring-positioner(search-for, 
  190.                          case-sensitive: case-sensitive);
  191.   if (replace-with)
  192.     method (big :: <byte-string>, #key count, start = 0, 
  193.         end: input-end = size(big))
  194.      => new-string :: <byte-string>;
  195.       do-replacement(positioner, replace-with, big, start, 
  196.              input-end, count, #f);
  197.     end method;
  198.   else
  199.     method (big :: <byte-string>, replace-with :: <string>, 
  200.         #key count, start = 0, end: input-end = size(big))
  201.      => new-string :: <byte-string>;
  202.       do-replacement(positioner, replace-with, big, start, 
  203.              input-end, count, #f);
  204.     end method;
  205.   end if;
  206. end method make-substring-replacer;
  207.